RPU 2013 Analyse

date()
<<<<<<< HEAD
## [1] "Fri Jan 16 16:21:38 2015"
=======
## [1] "Fri Jan 16 15:59:21 2015"
>>>>>>> 0eebf275a194c00563052db414b136564882cf48

source: RPU2013 Ce document exploite le fichier RData préparé à partir de la table *RPU__* de Sagec. Voir le document RPU_2013_Preparation.Rmd du dossier Resural (Resural/Stat Resural/RPU2013/

EN FONCTION DU MOIS MODIFIER LES LIGNES 12, 38, 39, 40 ET 66

Variables globales:

source("../prologue.R")
## Loading required package: foreign
## Loading required package: survival
## Loading required package: splines
## Loading required package: MASS
## Loading required package: nnet
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## [1] "Fichier courant: rpu2013d0112.Rda"

Activité régionale

wd<-getwd()
# setwd("~/Documents/Resural/Stat Resural/RPU2013/Chapitres/Activite_regionale")
# source(paste(path,"mes_fonctions.R",sep=""))

Librairies nécessaires:

load_libraries()

Lecture du fichier des données

On lit le fichier de travail créé:

d1<-foo(path)

# if(!exists("d1")) {
# load(paste(path,"rpu2013d0109.Rda",sep=""))
# d1<-d0109
# rm(d0109)
# }

Analyse des données

entrées par secteur sanitaire (voir Territoire_Sante.Rmd)

On creé une colonne supplémentaire secteur qui indique à quel secteur sanitaire correspond le RPU:

Nombre de RPU par secteur de santé

tapply(d1$ENTREE,d1$secteur,length)
##      1      2      3      4 
##  59484  62981 109395 112213

Remarques: - secteur 2, manque St Anne, pediatrie HTP, une partie des RPU HUS adulte

entrées totales

# d1<-d1[d1$ENTREE<"2013-10-01",]

e<-as.Date(d1$ENTREE)
q<-tapply(e,yday(e),length)
mean(q) # nb moyen de passages
## [1] 945.2555
plot(q,type="l")
<<<<<<< HEAD

z<-zoo(q,unique(as.Date(d1$ENTREE)))
plot(z)

plot(xts(z), main="Activité quotidienne des Services d'urgence\nen Alsace",ylab="nombre de passages",minor.ticks=FALSE)
lines(rollmean(xts(z), 7),col="red",lwd=2)
copyright()

=======

z<-zoo(q,unique(as.Date(d1$ENTREE)))
plot(z)

plot(xts(z), main="Activité quotidienne des Services d'urgence\nen Alsace",ylab="nombre de passages",minor.ticks=FALSE)
lines(rollmean(xts(z), 7),col="red",lwd=2)
copyright()

>>>>>>> 0eebf275a194c00563052db414b136564882cf48
plot(z, col="gray45", main="Activité quotidienne des Services d'urgence\nen Alsace",ylab="nombre de passages",xlab="Année 2013")
lines(rollmean(z, 7),col="red",lwd=2)
abline(h = mean(q), col = "blue")
copyright()
legend("topleft",legend="moyenne lissée",col="red",lty=1,cex=0.8,bty="n")
<<<<<<< HEAD

Variables: - e vecteur contenant les dates d’entrées depuis le début de l’année - q vecteur contenant le nombre d’entrées par jour depuis le début de l’année - q2 vecteur contenant le nombre de retours à domiciles par jour - q3 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux) - q4 vecteur contenant le nombre de retours à domiciles par jour en excluant les non réponses (NA) - q5 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux), en excluant les non réponses (NA) - q6 taux de non réponses - q7 vecteur contenant le taux d’hospitalisation par jour (miroir de q5)

=======

Variables: - e vecteur contenant les dates d’entrées depuis le début de l’année - q vecteur contenant le nombre d’entrées par jour depuis le début de l’année - q2 vecteur contenant le nombre de retours à domiciles par jour - q3 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux) - q4 vecteur contenant le nombre de retours à domiciles par jour en excluant les non réponses (NA) - q5 vecteur contenant la proportion de retours à domicile par rapport au nombre d’entrées, par jour (taux), en excluant les non réponses (NA) - q6 taux de non réponses - q7 vecteur contenant le taux d’hospitalisation par jour (miroir de q5)

>>>>>>> 0eebf275a194c00563052db414b136564882cf48

Retour à domicile

Les variation du retour journalier à domicile sont calculés de la manière suivante: - numérateur = somme quotidienne où MODE_SOTIE == Domicile - dénominateur = somme quotidienne des ENTREE (correspod à q)

q2<-tapply(d1[d1$MODE_SORTIE=="Domicile",6],yday(d1[d1$MODE_SORTIE == "Domicile", 6]),length)
head(q2)
##   1   2   3   4   5   6 
## 593 547 449 460 486 511
q3<-q2/q
summary(q3)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.5750  0.6243  0.6447  0.6482  0.6680  0.7720
plot(q3,type="l")
copyright()
<<<<<<< HEAD

On refait le calcul de q en tenant compte des non réponses:

=======

On refait le calcul de q en tenant compte des non réponses:

>>>>>>> 0eebf275a194c00563052db414b136564882cf48
q4<-tapply(d1[!is.na(d1$MODE_SORTIE),6],yday(d1[!is.na(d1$MODE_SORTIE), 6]),length)
head(q4)
##   1   2   3   4   5   6 
## 815 751 633 654 653 654
q5<-q2/q4
head(q5)
##         1         2         3         4         5         6 
## 0.7276074 0.7283622 0.7093207 0.7033639 0.7442573 0.7813456
summary(q5)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.6702  0.7298  0.7512  0.7523  0.7725  0.8272
plot(q5,type="l",main="Taux de retour à domicile\n(non réponses exclues)",ylab="Fréquence",xlab="Jours")
copyright()
<<<<<<< HEAD

z <- zoo(q5, unique(as.Date(d1$ENTREE)))
plot(z,main="Taux de retour à domicile\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours")

plot(xts(z))
lines(rollmean(xts(z), 7), col = "red",lwd=2)
copyright()

Taux d’hospitalisation ———————- c’est le complément (miroir) du précédent:

=======

z <- zoo(q5, unique(as.Date(d1$ENTREE)))
plot(z,main="Taux de retour à domicile\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours")

plot(xts(z))
lines(rollmean(xts(z), 7), col = "red",lwd=2)
copyright()

Taux d’hospitalisation ———————- c’est le complément (miroir) du précédent:

>>>>>>> 0eebf275a194c00563052db414b136564882cf48
q7<-1-q2/q4
head(q7)
##         1         2         3         4         5         6 
## 0.2723926 0.2716378 0.2906793 0.2966361 0.2557427 0.2186544
summary(q7)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.1728  0.2275  0.2488  0.2477  0.2702  0.3298
z <- zoo(q7, unique(as.Date(d1$ENTREE)))
<<<<<<< HEAD
plot(xts(z),main="Taux d'hospitalisation en Alsace à partir des SU\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours")
lines(rollmean(xts(z), 7), col = "blue",lwd=2)
copyright()

======= plot(xts(z),main="Taux d'hospitalisation en Alsace à partir des SU\n(non réponses exclues)",ylab="Fréquence",xlab="Période (moyenne lissée sur 7 jours)", minor.ticks = FALSE) lines(rollmean(xts(z), 7), col = "blue",lwd=2) copyright()

>>>>>>> 0eebf275a194c00563052db414b136564882cf48

Taux de non réponses:

q6<-q4/q
head(q6)
##         1         2         3         4         5         6 
## 0.8754028 0.8845701 0.8767313 0.8731642 0.8592105 0.8825911
summary(q6)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.7925  0.8416  0.8627  0.8616  0.8788  0.9529

remarque: la distribution de l’age n’est pas normale

sd <- sd(d1$AGE, na.rm=TRUE)
m <- mean(d1$AGE, na.rm=TRUE)
age <- seq(0,120,1)
hist(d1$AGE, freq = FALSE)
lines(age, dnorm(age,m,sd))
lines(c(m,m), c(0,dnorm(m,m,sd)), col="red")
<<<<<<< HEAD

=======

>>>>>>> 0eebf275a194c00563052db414b136564882cf48
# si on étudie les majeurs
ma <- mean(d1$AGE[d1$AGE > 17], na.rm=TRUE)
sda <- sd(d1$AGE[d1$AGE > 17], na.rm=TRUE)
hist(d1$AGE[d1$AGE > 17], freq = FALSE)
<<<<<<< HEAD

=======

>>>>>>> 0eebf275a194c00563052db414b136564882cf48